home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / image-mode.el.z / image-mode.el
Encoding:
Text File  |  1998-05-21  |  5.2 KB  |  184 lines
  1. ;;; image-mode.el --- Major mode for navigate images
  2.  
  3. ;; Copyright (C) 1997 MORIOKA Tomohiko
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Created: 1997/6/27
  7. ;; Version: image-mode.el,v 20.3.1.2 1997/07/01 17:29:44 morioka Exp
  8. ;; Keywords: image, graphics
  9.  
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25. ;; 02111-1307, USA.
  26.  
  27. ;;; Code:
  28.  
  29. (defvar buffer-image-format nil)
  30. (make-variable-buffer-local 'buffer-image-format)
  31.  
  32. (defsubst image-decode (start end type)
  33.   "Decode the image between START and END which is encoded in TYPE."
  34.   (save-excursion
  35.     (let ((image (make-image-instance
  36.           (vector type :data (buffer-string)) nil nil 'no-error)))
  37.       (delete-region start end)
  38.       (if image
  39.       (let ((glyph (make-glyph image)))
  40.         (set-extent-begin-glyph (make-extent start start) glyph)
  41.         (setq buffer-read-only t)
  42.         )
  43.     (insert (format "%s is not supported!\n" type))
  44.     (let ((overriding-local-map image-mode-map))
  45.       (insert
  46.        (substitute-command-keys
  47.         "
  48. Please type `\\[image-toggle-decoding]' if you would like to display
  49. raw data.
  50. Please type `\\[image-enter-hexl-mode]' if you would like to edit hex
  51. data.
  52. Please type `\\[image-start-external-viewer]' if you would like to
  53. display contents of this buffer by external viewer.\n")))
  54.     (call-interactively 'fill-paragraph)
  55.     )
  56.       start)))
  57.  
  58. (defvar image-mode-map (make-keymap))
  59. (suppress-keymap image-mode-map)
  60. (define-key image-mode-map "v" 'image-start-external-viewer)
  61. (define-key image-mode-map "t" 'image-toggle-decoding)
  62. (define-key image-mode-map "h" 'image-enter-hexl-mode)
  63. (define-key image-mode-map "q" 'image-mode-quit)
  64.  
  65. (defvar image-external-viewer
  66.   (cond ((exec-installed-p "display")     "display")    ; ImageMagic
  67.     ((exec-installed-p "xv")     "xv")        ; xv
  68.     )
  69.   "*External viewer for image-mode.")
  70.  
  71. (defun image-start-external-viewer ()
  72.   "Start external image viewer for current-buffer.
  73. It uses `image-external-viewer' as external image viewer."
  74.   (interactive)
  75.   (start-process "external image viewer" nil
  76.          image-external-viewer buffer-file-name)
  77.   )
  78.  
  79. (defun image-toggle-decoding ()
  80.   "Toggle image display mode in current buffer."
  81.   (interactive)
  82.   (if buffer-file-format
  83.       (progn
  84.     (setq buffer-read-only nil)
  85.     (erase-buffer)
  86.     (map-extents (function
  87.               (lambda (extent maparg)
  88.             (delete-extent extent)
  89.             )) nil (point-min)(point-min))
  90.     (setq buffer-file-format nil)
  91.     (insert-file-contents-literally buffer-file-name)
  92.     (set-buffer-modified-p nil)
  93.     )
  94.     (format-decode-buffer buffer-image-format)
  95.     ))
  96.  
  97. (defun image-exit-hexl-mode-function ()
  98.   (format-decode-buffer)
  99.   (remove-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function)
  100.   )
  101.  
  102. (defun image-enter-hexl-mode ()
  103.   "Enter to hexl-mode."
  104.   (interactive)
  105.   (when buffer-file-format
  106.     (setq buffer-read-only nil)
  107.     (erase-buffer)
  108.     (map-extents (function
  109.           (lambda (extent maparg)
  110.             (delete-extent extent)
  111.             )) nil (point-min)(point-min))
  112.     (setq buffer-file-format nil)
  113.     (insert-file-contents-literally buffer-file-name)
  114.     (set-buffer-modified-p nil)
  115.     (add-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function)
  116.     )
  117.   (hexl-mode)
  118.   )
  119.  
  120. (defun image-mode-quit ()
  121.   "Exit image-mode."
  122.   (interactive)
  123.   (kill-buffer (current-buffer))
  124.   )
  125.  
  126. (defun image-maybe-restore ()
  127.   "Restore buffer from file if it is decoded as `buffer-file-format'."
  128.   (when (and buffer-file-format
  129.          buffer-file-name)
  130.     (setq buffer-read-only nil)
  131.     (erase-buffer)
  132.     (map-extents (function
  133.           (lambda (extent maparg)
  134.             (delete-extent extent)
  135.             )) nil (point-min)(point-min))
  136.     (setq buffer-file-format nil)
  137.     (insert-file-contents-literally buffer-file-name)
  138.     (set-buffer-modified-p nil)
  139.     ))
  140.  
  141. (add-hook 'change-major-mode-hook 'image-maybe-restore)
  142.  
  143.  
  144. ;;;###autoload
  145. (defun image-mode (&optional arg)
  146.   "\\{image-mode-map}"
  147.   (interactive)
  148.   (setq major-mode 'image-mode)
  149.   (setq mode-name "Image")
  150.   (use-local-map image-mode-map)
  151.   )
  152.  
  153. ;;;###autoload
  154. (defun image-decode-jpeg (start end)
  155.   "Decode JPEG image between START and END."
  156.   (setq buffer-image-format 'image/jpeg)
  157.   (image-decode start end 'jpeg)
  158.   )
  159.  
  160. ;;;###autoload
  161. (defun image-decode-gif (start end)
  162.   "Decode GIF image between START and END."
  163.   (setq buffer-image-format 'image/gif)
  164.   (image-decode start end 'gif)
  165.   )
  166.  
  167. ;;;###autoload
  168. (defun image-decode-png (start end)
  169.   "Decode PNG image between START and END."
  170.   (setq buffer-image-format 'image/png)
  171.   (image-decode start end 'png)
  172.   )
  173.  
  174. ;;;###autoload
  175. (defun image-decode-xpm (start end)
  176.   "Decode XPM image between START and END."
  177.   (setq buffer-image-format 'image/x-xpm)
  178.   (image-decode start end 'xpm)
  179.   )
  180.  
  181. (provide 'image-mode)
  182.  
  183. ;;; image-mode.el ends here
  184.